home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbscr15.zip / DEMO.BAS < prev    next >
BASIC Source File  |  1989-09-01  |  45KB  |  1,248 lines
  1. '┌─────────────────────────────────────────────────────────────────────────┐
  2. '│                                                                         │
  3. '│                            D E M O . B A S                              │
  4. '│                                                                         │
  5. '│                  ░▒▓█  A Demonstration Program  █▓▒░                    │
  6. '│                                                                         │
  7. '│                   making known the capabilities of                      │
  8. '│                       the QBSCR Screen Routines                         │
  9. '│                                                                         │
  10. '├─────────────────────────────────────────────────────────────────────────┤
  11. '│                                                                         │
  12. '│  The QBSCR Screen Routines and this DEMO program are (C) Copyright 1989 │
  13. '│               by Tony Martin of the BAD SOFTWARE Company.               │
  14. '│                                                                         │
  15. '├─────────────────────────────────────────────────────────────────────────┤
  16. '│                                                                         │
  17. '│  Author  : Tony Martin                                                  │
  18. '│  Date    : September 1, 1989                                            │
  19. '│  Language: Microsoft QuickBASIC 4.0+                                    │
  20. '│                                                                         │
  21. '└─────────────────────────────────────────────────────────────────────────┘
  22.  
  23. '----------------------------------------------------------------------------
  24. ' CONSTants
  25. '----------------------------------------------------------------------------
  26. ' Color constants
  27. CONST BLACK = 0
  28. CONST BLUE = 1
  29. CONST GREEN = 2
  30. CONST CYAN = 3
  31. CONST RED = 4
  32. CONST MAGENTA = 5
  33. CONST BROWN = 6
  34. CONST WHITE = 7
  35. CONST BRIGHT = 8
  36. CONST YELLOW = BRIGHT + BROWN
  37. CONST BLINK = 16
  38.  
  39. ' General constants
  40. CONST FALSE = 0, TRUE = NOT FALSE
  41. CONST maxEntries = 13
  42.  
  43. '----------------------------------------------------------------------------
  44. ' SHARED variables (keep these to an absolute minimum)
  45. '----------------------------------------------------------------------------
  46. COMMON SHARED kolor%
  47.  
  48. '----------------------------------------------------------------------------
  49. ' DECLARE statements for the QBSCR Screen Routines
  50. '----------------------------------------------------------------------------
  51. DECLARE FUNCTION BlockSize% (l%, r%, t%, b%)
  52. DECLARE FUNCTION ColorChk ()
  53. DECLARE FUNCTION GetBackground% (row%, col%)
  54. DECLARE FUNCTION GetForeground% (row%, col%)
  55. DECLARE FUNCTION GetString$ (leftCol!, row%, strLen%, foreColor%, backColor%)
  56. DECLARE FUNCTION GetVideoSegment! ()
  57. DECLARE FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
  58. DECLARE FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
  59. DECLARE FUNCTION ScreenBlank$ (delay)
  60. DECLARE SUB Banner (st$, row%)
  61. DECLARE SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!)
  62. DECLARE SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!)
  63. DECLARE SUB BuildScreen (file$, mode%)
  64. DECLARE SUB Center (st$, row%)
  65. DECLARE SUB ClrScr (mode%, fillChar$)
  66. DECLARE SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%)
  67. DECLARE SUB GetScreen (file$)
  68. DECLARE SUB PutScreen (file$)
  69. DECLARE SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$)
  70. DECLARE SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%)
  71. DECLARE SUB OffCenter (st$, row%, leftCol%, rightCol%)
  72. DECLARE SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment)
  73. DECLARE SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment)
  74. DECLARE SUB Wipe (top%, bottom%, lft%, rght%, back%)
  75.  
  76. '----------------------------------------------------------------------------
  77. ' DECLARE statements for routines local to this program
  78. '----------------------------------------------------------------------------
  79. DECLARE FUNCTION Pause% (delay!)
  80. DECLARE SUB BannerDemo ()
  81. DECLARE SUB BlockDemo ()
  82. DECLARE SUB BuildScreenDemo ()
  83. DECLARE SUB CenterOffCenterDemo ()
  84. DECLARE SUB ClosingScreen ()
  85. DECLARE SUB ClrScrDemo ()
  86. DECLARE SUB GetFgBgDemo ()
  87. DECLARE SUB GetPutScreenInfo ()
  88. DECLARE SUB Initialize ()
  89. DECLARE SUB KeyPause ()
  90. DECLARE SUB MenuScreen ()
  91. DECLARE SUB MakeMenuInfo ()
  92. DECLARE SUB MakeWindowDemo ()
  93. DECLARE SUB MovingMessage ()
  94. DECLARE SUB MultiMenuDemo ()
  95. DECLARE SUB OpenScreen ()
  96. DECLARE SUB PointerBox (row%, col%)
  97. DECLARE SUB ScreenBlankDemo ()
  98. DECLARE SUB ScreenInfo ()
  99. DECLARE SUB WipeDemo ()
  100.  
  101. '----------------------------------------------------------------------------
  102. ' The whole of the module-level program...
  103. '----------------------------------------------------------------------------
  104.  
  105.     Initialize
  106.     OpenScreen
  107.     MenuScreen
  108.     ClosingScreen
  109.  
  110. '----------------------------------------------------------------------------
  111. '                                The END
  112. '----------------------------------------------------------------------------
  113.  
  114. SUB BannerDemo
  115.  
  116.     ' Set the colors for "Quit" at the bottom of the screen.  Make it blink.
  117.     IF kolor% THEN
  118.         COLOR BLINK + BRIGHT + RED, BLACK
  119.     ELSE
  120.         COLOR BLINK + BRIGHT + WHITE, BLACK
  121.     END IF
  122.  
  123.     Center "Quit ∙ ESC", 21
  124.  
  125.     ' Set colors for the banner itself
  126.     IF kolor% THEN
  127.         COLOR BRIGHT + RED, BLACK
  128.     ELSE
  129.         COLOR BRIGHT + WHITE, BLACK
  130.     END IF
  131.  
  132.     st$ = "  The QBSCR Screen Routines Demonstration!  "
  133.     k$ = ""
  134.    
  135.     ' Let the banner scroll until the user hits a key
  136.     done% = FALSE
  137.     DO
  138.         k$ = INKEY$
  139.         IF k$ <> "" THEN
  140.             done% = TRUE
  141.         ELSE
  142.             Banner st$, 3
  143.         END IF
  144.     LOOP UNTIL done%
  145.  
  146. END SUB
  147.  
  148. SUB BlockDemo
  149.  
  150.     ' Define colors for this demo
  151.     IF kolor% THEN
  152.         infoFG% = BRIGHT + CYAN: infoBG% = RED
  153.         blockFG% = RED: blockBG% = CYAN
  154.     ELSE
  155.         infoFG% = BLACK: infoBG% = WHITE
  156.         blockFG% = BLACK: blockBG% = WHITE
  157.     END IF
  158.  
  159.     ' Make the window explaining what's going on
  160.     MakeWindow 7, 36, 22, 75, infoFG%, infoBG%, 0, 1, 16, 1, " Block Save/Restore "
  161.     OffCenter "Using the Block Save and Restore", 9, 35, 75
  162.     OffCenter "routines is easy.  Simply Save a", 10, 35, 75
  163.     OffCenter "portion of the screen with Block", 11, 35, 75
  164.     OffCenter "Save, write overtop of that area", 12, 35, 75
  165.     OffCenter "and then restore the area with", 13, 35, 75
  166.     OffCenter "the Block Restore routine.", 14, 35, 75
  167.     OffCenter "In the example at the left, this", 16, 35, 75
  168.     OffCenter "is being done repeatedly to", 17, 35, 75
  169.     OffCenter "achieve the movement effect.", 18, 35, 75
  170.     OffCenter "Hit any key when you are done.", 20, 35, 75
  171.  
  172.     ' DIMensions a couple arrays to save screen information
  173.     DIM blockArray%(BlockSize%(10, 25, 15, 19))
  174.     DIM winArray%(BlockSize%(10, 25, 15, 19))
  175.  
  176.     ' Perform initial save of screen block
  177.     l% = 10: r% = 25: t% = 15: b% = 19
  178.     BlockSave l%, r%, t%, b%, blockArray%(), GetVideoSegment
  179.    
  180.     ' Make the window to move
  181.     MakeWindow 15, 10, 19, 25, blockFG%, blockBG%, 0, 1, -1, 0, ""
  182.     OffCenter "A", 16, 10, 25
  183.     OffCenter "Moving", 17, 10, 25
  184.     OffCenter "Window", 18, 10, 25
  185.     BlockSave l%, r%, t%, b%, winArray%(), GetVideoSegment
  186.  
  187.     ' Sit in a loop performing the animation until user hits a key
  188.     done% = FALSE
  189.     stage% = 0    ' Stage = 0 : window moves up
  190.                   ' Stage = 1 : window moves right
  191.                   ' Stage = 2 : window moves down and left
  192.     intraDelay = 100
  193.    
  194.     DO
  195.         SELECT CASE stage%
  196.         CASE 0    ' window moves up
  197.  
  198.             FOR x% = 14 TO 5 STEP